home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / GEMSCAN.I < prev    next >
Encoding:
Modula Implementation  |  1990-11-25  |  3.5 KB  |  129 lines
  1. IMPLEMENTATION MODULE GEMScan;
  2. (*$Y+,R-,S-*)
  3.  
  4. FROM SYSTEM IMPORT LONGWORD, WORD, ADDRESS, BYTE, ADR;
  5.  
  6. FROM SysTypes IMPORT ScanDesc;
  7.  
  8. FROM SysCtrl IMPORT ScanBack;
  9.  
  10. FROM AESForms IMPORT FormAlert;
  11.  
  12. FROM StrConv IMPORT CardToStr, StrToLCard, IntToStr, LHexToStr;
  13.  
  14. FROM ModCtrl IMPORT GetModName, GetSourceName;
  15.  
  16. FROM Strings IMPORT String, Pos, Delete, Assign, Insert, Concat, Copy, Length,
  17.         Empty, Append, Upper;
  18.  
  19. VAR strVal: BOOLEAN;
  20.  
  21. PROCEDURE InitChain ( pos: ScanDesc );
  22.   BEGIN
  23.     ChainDepth:= 0;
  24.     REPEAT
  25.       WITH CallingChain [ChainDepth] DO
  26.         GetModName (pos.pc, modName, relAddr, procName);
  27.         IF modName [0] = 0C THEN
  28.           relAddr:= pos.pc
  29.         END;
  30.         GetSourceName (modName, sourceName, codeOpts)
  31.       END;
  32.       INC (ChainDepth)
  33.     UNTIL (ChainDepth > MaxDepth) OR ~ScanBack (pos);
  34.     DEC (ChainDepth)
  35.   END InitChain;
  36.  
  37.  
  38. PROCEDURE apnd (REF s:ARRAY OF CHAR; VAR to: ARRAY OF CHAR);
  39.   BEGIN
  40.     Append (s,to,strVal)
  41.   END apnd;
  42.  
  43. PROCEDURE InputScan ( REF msg: ARRAY OF CHAR; VAR index: CARDINAL );
  44.   
  45.   VAR scan: ScanDesc;
  46.       msg2, msg1:ARRAY [0..166] OF CHAR; (* reicht f. 5 Zeilen *)
  47.       pos2, pos: INTEGER;
  48.       lines, button, exBut, fwBut, baBut: CARDINAL;
  49.  
  50.   BEGIN
  51.     IF index>=0 THEN
  52.       IF index>CARDINAL(ChainDepth) THEN index:= ChainDepth END;
  53.       LOOP
  54.         IF msg[0]#0C THEN
  55.           Assign (msg, msg2, strVal);
  56.           (* maximal 2 Zeilen à 29 Zeichen: *)
  57.           pos:= Pos ('|', msg2, 0);
  58.           IF pos < 0 THEN
  59.             lines:= 1;
  60.             msg2 [29]:= 0C
  61.           ELSE
  62.             IF pos > 29 THEN
  63.               Delete (msg2, 29, pos-29, strVal);
  64.               pos:= 29
  65.             END;
  66.             lines:= 2;
  67.             msg2 [pos+30]:= 0C;
  68.             pos2:= Pos ('|', msg2, pos+1);
  69.             IF pos2 >= 0 THEN
  70.               msg2 [pos2] := 0C
  71.             END
  72.           END;
  73.           Append ('|', msg2, strVal);
  74.         ELSE
  75.           lines:= 0;
  76.           msg2:= ''
  77.         END;
  78.         IF CallingChain [index].modName[0] = 0C THEN
  79.           apnd ("Unbekannter Programmbereich,|Adresse: ",msg2)
  80.         ELSE
  81.           INC (lines);
  82.           apnd ("Modul '",msg2);
  83.           Copy (CallingChain [index].modName,0,22,msg1,strVal);
  84.           apnd (msg1,msg2);
  85.           IF CallingChain [index].procName[0] # 0C THEN
  86.             apnd ("'|Proc '",msg2);
  87.             Copy (CallingChain [index].procName,0,24,msg1,strVal);
  88.             apnd (msg1,msg2);
  89.             apnd ("'",msg2)
  90.           ELSE
  91.             apnd ("'| ",msg2);
  92.           END;
  93.           apnd ("|Offset: ",msg2)
  94.         END;
  95.         apnd (LHexToStr(CallingChain [index].relAddr,0),msg2);
  96.         IF lines < 3 THEN
  97.           Concat ('|Tiefe: ',CardToStr (index,0),msg1,strVal);
  98.           apnd (msg1,msg2)
  99.         END;
  100.         exBut:= 1; fwBut:= 0; baBut:= 0;
  101.         msg1:= '[0][][EXIT]';
  102.         IF index>0 THEN
  103.           Insert ('Frwd|',6,msg1,strVal);
  104.           INC (fwBut);
  105.           INC (exBut)
  106.         END;
  107.         IF INTEGER(index)<ChainDepth THEN
  108.           Insert ('Back|',6,msg1,strVal);
  109.           INC (baBut);
  110.           IF fwBut#0 THEN INC (fwBut) END;
  111.           INC (exBut)
  112.         END;
  113.         Insert (msg2,4,msg1,strVal);
  114.         FormAlert (exBut, msg1,button);
  115.         IF button=exBut THEN (* Exit *)
  116.           EXIT
  117.         ELSIF button=fwBut THEN
  118.           DEC (index)
  119.         ELSE
  120.           INC (index)
  121.         END
  122.       END  (* LOOP *)
  123.     END
  124.   END InputScan;
  125.  
  126. BEGIN
  127.   ChainDepth:= -1
  128. END GEMScan.
  129.